home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / nbasic_2.zip / DEMOGAME.BAS
BASIC Source File  |  1996-06-30  |  10KB  |  396 lines
  1. DECLARE SUB NewScreen (UD, RL, k2, m1, s1, s2, k1)
  2. DECLARE SUB DemoCheck (UD, RL, XX, YY, k1, k2, s1, s2, m1)
  3. DECLARE SUB Battle ()
  4. DECLARE SUB MainBattle ()
  5. DECLARE SUB Center (Col, T$)
  6. DECLARE SUB Border ()
  7. COMMON SHARED RL, UD, Level, Hp, MaxHp, Str, Df, W, SH, ARM, HLM, XX, YY
  8. SHELL "cd\ideas"
  9. CLEAR
  10. DIM colr1(50)
  11. DIM char$(50)
  12. CLS
  13. SCREEN 12
  14. FOR i = 1 TO 5
  15. READ a, b$
  16. colr1(i) = a
  17. char$(i) = b$
  18. DATA 4,"H",1,"o",14,"j",2,"u",5,"!"
  19. NEXT i
  20. FOR i = 1 TO 5
  21. PALETTE colr1(i), 0
  22. NEXT i
  23. 'SHELL "d:\gary\audio\stop -q"
  24. 'SHELL "d:\gary\audio\daplay d:\gary\audio\j3.wav -q -r"
  25. FOR i = 0 TO 63
  26. PALETTE 4, 65536 * 0 + 256 * 0 + i
  27. PALETTE 1, 65536 * i + 256 * 0 + 0
  28. PALETTE 14, 65536 * 0 + 256 * i + i
  29. PALETTE 2, 65536 * 0 + 256 * i + 0
  30. PALETTE 5, 65536 * i + 256 * 0 + i
  31. FOR x = 37 TO 41
  32. COLOR colr1(x - 36): LOCATE 15, x: PRINT char$(x - 36)
  33. NEXT x, i
  34. FOR i = 1 TO 1000: NEXT i
  35. FOR i = 63 TO 0 STEP -1
  36. PALETTE 4, 65536 * 0 + 256 * 0 + i
  37. PALETTE 1, 65536 * i + 256 * 0 + 0
  38. PALETTE 14, 65536 * 0 + 256 * i + i
  39. PALETTE 2, 65536 * 0 + 256 * i + 0
  40. PALETTE 5, 65536 * i + 256 * 0 + i
  41. NEXT i
  42. FOR i = 1 TO 2000: NEXT i
  43. TitleScreen:
  44. PX = 0
  45. CLS
  46. PALETTE 15, 0
  47. Center 14, "Baron's Quest"
  48. Center 15, "New Game"
  49. Center 16, "Load Game"
  50. FOR i = 0 TO 63
  51. PALETTE 15, 65536 * i + 256 * i + i
  52. NEXT i
  53. l = 15
  54. COLOR 15
  55. Line0:
  56. DO
  57. LOCATE l, 35
  58. PRINT CHR$(26)
  59. DO
  60. x$ = INKEY$: LOOP UNTIL x$ <> ""
  61. IF x$ = CHR$(13) THEN EXIT DO
  62. IF x$ = CHR$(0) + "P" AND l = 15 THEN l = 16: LOCATE 15, 35: PRINT " "
  63. IF x$ = CHR$(0) + "H" AND l = 16 THEN l = 15: LOCATE 16, 35: PRINT " "
  64. LOOP
  65. IF l = 15 THEN GOTO NewGame
  66. IF l = 16 THEN GOTO LoadGame
  67. NewGame:
  68. Level = 1
  69. Str = 10
  70. Df = 5
  71. Hp = 25
  72. MaxHp = 25
  73. RL = 0
  74. UD = 0
  75. XX = 15
  76. YY = 39
  77. W = 1
  78. SH = 1
  79. ARM = 1
  80. HLM = 0
  81. GOTO Episode1
  82. EP = 0
  83. MaxEP = 30
  84. END
  85. LoadGame:
  86. Center 17, CHR$(218) + STRING$(18, 196) + CHR$(191)
  87. FOR i = 18 TO 22 STEP 2
  88. Center i, CHR$(179) + SPACE$(18) + CHR$(179)
  89. NEXT i
  90. FOR i = 19 TO 21 STEP 2
  91. Center i, CHR$(195) + STRING$(18, 196) + CHR$(180)
  92. NEXT i
  93. Center 23, CHR$(192) + STRING$(18, 196) + CHR$(217)
  94. ON ERROR GOTO Empty1
  95. OPEN "save1.gam" FOR INPUT AS #1
  96. Line1:
  97. ON ERROR GOTO Empty2
  98. OPEN "save2.gam" FOR INPUT AS #2
  99. Line2:
  100. ON ERROR GOTO Empty3
  101. OPEN "save3.gam" FOR INPUT AS #3
  102. ReadName:
  103. IF file1 = 0 THEN INPUT #1, Name$(1) ELSE Name$(1) = "- Empty -"
  104. IF file2 = 0 THEN INPUT #2, Name$(2) ELSE Name$(2) = "- Empty -"
  105. IF file3 = 0 THEN INPUT #3, Name$(3) ELSE Name$(3) = "- Empty -"
  106. IF file1 = 0 OR file2 = 1 OR file3 = 1 THEN CLOSE
  107. l = 18
  108. Center 18, Name$(1)
  109. Center 20, Name$(2)
  110. Center 22, Name$(3)
  111. LoadSelect:
  112. LOCATE l, 29: PRINT CHR$(26)
  113. DO: x$ = INKEY$: LOOP UNTIL x$ <> ""
  114. SELECT CASE x$
  115.  CASE CHR$(27)
  116.  LOCATE 17, 1: PRINT SPACE$(560)
  117.  l = 16
  118.  GOTO Line0
  119.  CASE CHR$(13)
  120.  IF l = 18 AND file1 = 1 OR l = 20 AND file2 = 1 OR l = 22 AND file3 = 1 THEN SOUND 37, 2: GOTO LoadSelect
  121.  GOTO FileCheck
  122.  CASE CHR$(0) + "H"
  123.  IF l = 18 THEN GOTO LoadSelect
  124.  IF l = 20 OR l = 22 THEN LOCATE l, 29: PRINT " ": l = l - 2
  125.  GOTO LoadSelect
  126.  CASE CHR$(0) + "P"
  127.  IF l = 18 OR l = 20 THEN LOCATE l, 29: PRINT " ": l = l + 2
  128.  IF l = 22 THEN GOTO LoadSelect
  129.  GOTO LoadSelect
  130.  CASE ELSE
  131.  GOTO LoadSelect
  132. END SELECT
  133. Empty1:
  134. file1 = 1
  135. RESUME Line1
  136. Empty2:
  137. file2 = 1
  138. RESUME Line2
  139. Empty3:
  140. file3 = 1
  141. RESUME ReadName
  142. FileCheck:
  143. ON ERROR GOTO FileError
  144. IF l = 18 THEN OPEN "save1.gam" FOR INPUT AS #1
  145. IF l = 20 THEN OPEN "save2.gam" FOR INPUT AS #1
  146. IF l = 22 THEN OPEN "save3.gam" FOR INPUT AS #1
  147. INPUT #1, Name$
  148. INPUT #1, Level, Str, Df, Hp, MaxHp, RL, UD
  149. INPUT #1, XX, YY, W, SH, ARM, HLM, EP, MaxEP
  150. IF Level > 99 THEN Level = 1: Hp = 5: MaxHp = 5
  151. IF Hp > 999 THEN Hp = 5: MaxHp = 5
  152. IF MaxHp > 999 THEN MaxHp = 5
  153. IF Str > 99 THEN Str = 1
  154. IF Df > 99 THEN Df = 1
  155. IF W > 5 THEN W = 1
  156. IF SH > 3 THEN SH = 1
  157. IF ARM > 4 THEN ARM = 1
  158. IF HLM > 4 THEN HLM = 0
  159. GOTO Episode1
  160. END
  161. FileError:
  162. CLOSE
  163. 'SHELL "d:\gary\audio\stop -q"
  164. SCREEN 0
  165. COLOR 21
  166. Center 15, "Halt! The file you have loaded is damaged or not in " + CHR$(34) + "Baron's Quest" + CHR$(34)
  167. Center 16, "format! The file will be deleted!"
  168. IF l = 18 THEN KILL "save1.gam"
  169. IF l = 20 THEN KILL "save2.gam"
  170. IF l = 22 THEN KILL "save3.gam"
  171. Center 17, "Problem fixed! Press any key to return to system"
  172. Center 18, "P.S. Do not be afraid to restart the game! :)"
  173. x$ = INPUT$(1)
  174. COLOR 15, 0
  175. SYSTEM
  176. Episode1:
  177. CLS
  178. NewScreen UD, RL, k2, m1, s1, s2, k1
  179. Move1:
  180. COLOR 15: LOCATE XX, YY: PRINT CHR$(2)
  181. DO: x$ = INKEY$: LOOP UNTIL x$ <> ""
  182. SELECT CASE x$
  183. CASE " "
  184. DemoCheck UD, RL, XX, YY, k1, k2, s1, s2, m1: GOTO Move1
  185. CASE CHR$(0) + "H"
  186.  IF XX - 1 = 0 THEN XX = 23: UD = UD + 1: NewScreen UD, RL, k2, m1, s1, s2, k1: GOTO Move1
  187.  IF SCREEN(XX - 1, YY) <> 32 THEN GOTO Move1
  188.  LOCATE XX, YY: PRINT " ": XX = XX - 1
  189. CASE CHR$(0) + "P"
  190.  IF XX + 1 = 24 THEN XX = 1: UD = UD - 1: NewScreen UD, RL, k2, m1, s1, s2, k1: GOTO Move1
  191.  IF SCREEN(XX + 1, YY) <> 32 THEN GOTO Move1
  192.  LOCATE XX, YY: PRINT " ": XX = XX + 1
  193. CASE CHR$(0) + "K"
  194.  IF YY - 1 = 0 THEN YY = 80: RL = RL - 1: NewScreen UD, RL, k2, m1, s1, s2, k1: GOTO Move1
  195.  IF SCREEN(XX, YY - 1) <> 32 THEN GOTO Move1
  196.  LOCATE XX, YY: PRINT " ": YY = YY - 1
  197. CASE CHR$(0) + "M"
  198.  IF YY + 1 = 81 THEN YY = 1: RL = RL + 1: NewScreen UD, RL, k2, m1, s1, s2, k1: GOTO Move1
  199.  IF SCREEN(XX, YY + 1) <> 32 THEN GOTO Move1
  200.  LOCATE XX, YY: PRINT " ": YY = YY + 1
  201. END SELECT
  202. GOTO Move1
  203.  
  204. SUB Battle ()
  205.  
  206. END SUB
  207.  
  208. SUB Border ()
  209. LOCATE 1, 1: PRINT STRING$(80, 219)
  210. FOR iii = 2 TO 22
  211. LOCATE iii, 1: PRINT CHR$(219); SPACE$(78); CHR$(219)
  212. NEXT iii
  213. LOCATE 23, 1: PRINT STRING$(80, 219)
  214. END SUB
  215.  
  216. SUB Center (Col, T$)
  217. COLOR 15
  218. LOCATE Col, 40 - (LEN(T$) / 2)
  219. PRINT T$
  220. END SUB
  221.  
  222. SUB DemoCheck (UD, RL, XX, YY, k1, k2, s1, s2, m1)
  223. PALETTE 15, 65536 * 63 + 256 * 63 + 63
  224. COLOR 15
  225. IF UD = 0 AND RL = 0 AND XX = 12 AND YY = 39 THEN
  226. LOCATE 24, 1: PRINT "The sign reads: Welcome to the underground!"
  227. x$ = INPUT$(1)
  228. LOCATE 24, 1: PRINT SPACE$(80)
  229. END IF
  230. IF UD = 0 AND RL = -2 AND XX = 3 AND YY = 2 THEN
  231. IF s1 = 0 THEN s1 = 1: cure = cure + 3: LOCATE 24, 1: PRINT "You have found a pack of herbs!": x$ = INPUT$(1): LOCATE 24, 1: PRINT SPACE$(80)
  232. END IF
  233. IF UD = 3 AND RL = -3 AND XX = 7 AND YY = 68 THEN
  234. IF s2 = 0 THEN s2 = 1: cure = cure + 3: LOCATE 24, 1: PRINT "You have found a pack of herbs!": x$ = INPUT$(1): LOCATE 24, 1: PRINT SPACE$(80)
  235. END IF
  236. IF UD = 4 AND RL = -1 AND XX = 3 AND YY = 39 THEN
  237. MainBattle
  238. END IF
  239. IF UD = 4 AND RL = 0 AND XX = 6 AND YY = 39 THEN
  240. IF k2 = 1 THEN k2 = 0: LOCATE 5, 39: PRINT CHR$(24) ELSE k2 = 1: LOCATE 5, 39: PRINT CHR$(25)
  241. END IF
  242. IF UD = 3 AND RL = -4 AND XX = 11 AND YY = 39 THEN
  243. IF k1 = 1 THEN k1 = 0: LOCATE 10, 39: PRINT CHR$(24) ELSE k1 = 1: LOCATE 10, 39: PRINT CHR$(25)
  244. END IF
  245. END SUB
  246.  
  247. SUB MainBattle ()
  248.  
  249. END SUB
  250.  
  251. SUB NewScreen (UD, RL, k2, m1, s1, s2, k1)
  252. CLS
  253. COLOR 14
  254. IF RL = 0 THEN PALETTE 14, 65536 * 63 + 256 * 63 + 63
  255. IF RL = -1 THEN PALETTE 14, 65536 * 50 + 256 * 50 + 50
  256. IF RL = -2 THEN PALETTE 14, 65536 * 20 + 256 * 20 + 20
  257. IF RL = -3 THEN PALETTE 14, 65536 * 5 + 256 * 5 + 5
  258. IF RL = -4 THEN PALETTE 14, 0
  259. IF UD = 0 AND RL = 0 THEN
  260. Border
  261. 'SHELL "d:\gary\audio\stop -q"
  262. 'SHELL "d:\gary\audio\daplay d:\gary\audio\undergrn.wav -q -r"
  263. LOCATE 1, 39: PRINT " "
  264. LOCATE 12, 1: PRINT " "
  265. LOCATE 11, 39: PRINT CHR$(232)
  266. END IF
  267. IF UD = 0 AND RL = -1 THEN
  268. Border
  269. LOCATE 12, 80: PRINT " "
  270. LOCATE 1, 39: PRINT " "
  271. LOCATE 12, 1: PRINT " "
  272. END IF
  273. IF UD = 1 AND RL = 0 THEN
  274. Border
  275. LOCATE 23, 39: PRINT " "
  276. LOCATE 12, 1: PRINT " "
  277. IF k1 = 1 THEN LOCATE 1, 39: PRINT " " ELSE LOCATE 1, 39: PRINT CHR$(8)
  278. END IF
  279. IF UD = 1 AND RL = -1 THEN
  280. Border
  281. LOCATE 23, 39: PRINT " "
  282. LOCATE 12, 80: PRINT " "
  283. LOCATE 1, 39: PRINT " "
  284. LOCATE 12, 1: PRINT " "
  285. END IF
  286. IF UD = 2 AND RL = 0 THEN
  287. Border
  288. LOCATE 1, 39: PRINT " "
  289. IF k1 = 1 THEN LOCATE 23, 39: PRINT " " ELSE LOCATE 23, 39: PRINT CHR$(8)
  290. END IF
  291. IF UD = 3 AND RL = 0 THEN
  292. Border
  293. LOCATE 1, 39: PRINT " "
  294. LOCATE 23, 39: PRINT " "
  295. END IF
  296. IF UD = 4 AND RL = 0 THEN
  297. Border
  298. LOCATE 23, 39: PRINT " "
  299. IF k2 = 1 THEN LOCATE 5, 39: PRINT CHR$(25) ELSE LOCATE 5, 39: PRINT CHR$(24)